perm filename OC.FOX[MF,ALS] blob sn#767288 filedate 1984-08-28 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00005 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	width reporting from GFTYPE
C00023 00003
C00035 00004	@ @<Glob...@>=
C00037 00005	Bask char 97: 3≤x<44   -1≤y<44
C00040 ENDMK
C⊗;
width reporting from GFTYPE
@ @<Process the character locations...@>=
repeat k←get_byte;
if k=char_loc then
	begin c←first_par(char_loc);
	v←signed_quad; w←signed_quad; p←signed_quad;
	if wants_mnemonics then
		begin print('Character ',c:1,': device width ',v:1,', width ',w:1,' (');
		print_scaled(w div 16);
		print_ln('ds), location ',p:1);
		end;
	if p≠char_ptr[c] then
		error('character location should be ',char_ptr[c]:1,'!');
@.character location should be...@>
	k←nop;
	end;
until k≠nop;

@ @<Process the character locations...@>=
repeat k←get_byte;
if k=char_loc then begin
	c←first_par(k);
	if c>max_glyph_no then abort('Character number too large');
	device_width[c]←signed_quad;
	tfm_width[c]←signed_quad;
	p←signed_quad;
	k←nop;
	end;
until k≠nop;


c←bs;
while c≤ec do 
  if glyph_ptr[c]≠-1 then
    begin
    oc_word(new_width(x_char_width[c]));
    oc_word(new_width(y_char_width[c]));
    oc_halfword(min_x_array[c];
    oc_halfword(min_y_array[c];
    oc_halfword(glyph_cols[c];
    oc_halfword(glyph_rows[c];
    end else
    begin
    i←1;
    while i≤7 do
      begin
      oc_halfword(0);
      incr(i);
      end;
      oc_halfword(-1);
    incr(c);
    end;
rel_ptr_base←char_seg_file_pos-2*nc;
c←bc;
while c≤ec do
  begin
  if glyph_ptr[c]≠-1 then oc_word(glyph_ptr[c]-rel_ptr_base)
  else oc_word(-1);
  incr(c);
  end;
print_nl; print('oc byte no at preamble end= '); print(oc_byte_no:4);


@!glyph_ptr: array [0..max_glyph_no] of integer; {called charsegptr in MFDOVR}
@!glyph_cols: array [0..max_glyph_no] of integer; {BBdxArray in MFDOVR}
@!glyph_rows: array [0..max_glyph_no] of integer; {BBdyArray in MFDOVR}
@!min_x_array: array [0..max_glyph_no] of integer; {BBoxArray in MFDOVR}
@!min_y_array: array [0..max_glyph_no] of integer; {BBoyArray in MFDOVR}
@!cols_offset: array [0..max_glyph_no] of integer; 
@!rows_offset: array [0..max_glyph_no] of integer; 

procedure makeoc # outputs the current character to .oc file;
begin integer i,x,y,ch;
integer padbits, charbits, charwords;
integer coladdr, wdaddr, shft, bitptr, pfield, accum, ocfilepos;
ch←openofil(doveroc);
if not bndboxvalid then bndbox;
if charsegptr[charcode]≠-1 then error("Duplicate charcode: '"&cvos(charcode));

bbdx←max_x+1-min_x;
bbdy←max_y+1-min_y;
bbox←min_x;
bboy←min_y;

bbdx_array[char_code]←bbdx;  bbdy_array[char_code]←bbdy;
bbox_array[char_code]←bbox;  bboy_array[char_code]←bboy;
	charwx←charwd;
	charwy←0.0;
	end;



CharWidthX[charcode]←charwx;
CharWidthY[charcode]←charwy;
charbits←bbdx*bbdy;
charwords←2*((charbits+31) div 32) # orbitchars block must be
	and even number of sixteen-bit words;
padbits←16*charwords-charbits;
charsegptr[charcode]←bytecount[doveroc] div 2 # bytes to 16-bit words;

@ We will have to make some calculations in floating point and convert the
results to integers.

@p function phys_size(i:integer):integer;
var r: real;
begin
r←(i*magnification*2540/ppi)+0.5;
phys_size←round(r);
end;

@#
function pix_res(i:real):integer;
var r: real;
begin
r←(i*ppi*10/magnification)+0.5;
pix_res←round(r);
end;

@#
function new_width(i:real):integer;
var r: real;
begin
r←(i*resolution*(2↑16))+0.5;
new_width←round(r);
end;

saf real array CharWidthX[0:'177];




@#
procedure oc_string(s:string; maxbytes:integer);
var i,len: integer;
begin
if maxbytes<length(s) then len←maxbytes else len←lenght(s);
oc_byte(len);
for i←1 to maxbytes-1 do
  if i<=len then oc_byte(s[i to i]) else oc_byte(0);
end;

@ Convert pixels to fixes, scaling out designsize. This is misplaced???

@<Subroutines...@>=
function amf_fix(i:integer):integer;
var r: real;
begin
r←i*(72.27/722.909)/(magnification*design_size/@"100000);
amf_fix←round(r*@"100000);
end;

oc_halfword((xresolution*ppi*10/magnification)+0.5);
oc_halfword((yresolution*ppi*10/magnification)+0.5);


  phys_size←(design_size*magnification*2540/ppi)+0.5;

oc_halfword(phys_size(design_size)); {physical size in micas}

@#
function phys_size(i:integer):integer;
var r: real;
begin
r←i*magnification*2540/ppi)+0.5;
phys_size←round(r);
end;


@#
function pix_res(i:integer):integer;
var r: real;
begin
r←i*ppi*10/magnification)+0.5);
pix_res←round(r);
end;


MFDOVR.SAI calls for;

Wout(doveroc,IX(1,12)) # header for family-name IX;
Wout(doveroc,IX(5,11)) # header for orbit-chars IX;

where IX is defined as:

define IX(typ, lngth)=⊂((typ lsh 12)+lngth)⊃;

simple procedure rastpreamble; begin integer i, n; string s; 
    define devstr=⊂"ImPrint-10"⊃,  shuv(a)="bout(rstfnt,a)";

    s← fontidentifier;	 # font identifier string;
    shuv(length(s)); while s≠"" do shuv(lop(s));

    s← fontfacebyte	 # font face byte string;
    shuv(length(s)); while s≠"" do shuv(lop(s));



,@ @procedure oc_string(s:string, maxbytes:integer);
var i,len: integer;
begin
len←(maxbytes-1) min length(s);
oc_byte(len);
for i←1 to maxbytes-1 do
  if i<=len then ocxbyte(s[i to i]) else oc_byte(0);
end;

@<Constants...@>=
@! char_seg_file_pos=1536; {halfword where raster information is to start}

@d chardw==device_width

@ @<Glob...@>=
@!seg_start: integer;
@!seg_end: integer;
@!newxwidth: integer;
@!phys_size: integer;




@ When we get to this section we have all the essential information needed to
write the preamble information into the |oc_file|.

@<Write the |oc| initial information@>=
begin
bc←0; while (glyph_ptr[bc]=-1) and (bc<max_glyph_no) do incr(bc);
ec←max_glyph_no;
while (glyph_ptr[ec]=-1) and (ec>0) do decr(ec);
if bc>ec then begin error('No characters in this font!'); goto 9998; end;
nc←ec+1-bc;
seg_start←char_seg_file_pos-(8+2)*nc;
seg_end←char_seg_file_pos+(wd_byte_no div 2);
if (font_face_byte<0) or (font_face_byte>127)  then error('Fontface out of bnds');
oc_halfword(0); {header for family-name IX}
oc_halfword(0); {name code}
oc_string(fontidentifier,20);
oc_halfword(0); {header for orbit-chars IX}
oc_byte(0); {name code again}
oc_byte(bc); {charcode for the first glyph}
oc_byte(ec); {charcode for the last glyph}
oc_byte(font_face_byte); {logical size encoded as font face byte}
  phys_size←(design_size*magnification*2540/ppi)+0.5;
oc_halfword(phys_size); {physical size in micas}
oc_halfword(0.5); {rotation in minutes of arc}
oc_word(char_seg_file_pos); {starting file pos of font segment in halfwords}
oc_word(wd_byte_no div 2); {font segment length in half words}
oc_halfword((xresolution*ppi/magnification)+0.5);
oc_halfword((yresolution*ppi/magnification)+0.5);
oc_halfword(IX); {endIX}
if oc_byte_no≠48 then error('This cannot happen: header error');
while oc_byte_no<((2*seg_start)-24) do oc_halfword(0); 
println; print('oc byte no = ',oc_byte_no:4); print(' at end of padding');
end

c← bc;
while c≤ec do
  begin
  if glyph_ptr[c]≠-1 then
    begin
    new_width←(CharWidthX[c]*xresolution*(2↑16))+0.5;
    oc_word(new_width); {this should be ?}
    oc_word(0); { I think CharWidthY this should be zero}
    oc_halfword(BBoxArray[c]);
    oc_halfword(BBoyArray[c]);
    oc_halfword(BBdxArray[c]);
    oc_halfeord(BBdyArray[c]);
    end
    else begin
    for i←1 thru 7 do oc_halfword(0);
    oc_halfword(-1) # marks a non-existent character;
    end;
  rel_ptr_base←char_seg_file_pos-2*nc;
 if ec_byte_no≠rel_ptr_base*2 then error('This can''t happen: ec byte no is off');
c←bc
while c≤ec do
  if glyph_ptr[c]≠-1 then oc_word(glyph_ptr[c]-rel_ptr_base)
    else oc_word(-1);
end;
rel_ptr_base←char_seg_file_pos-2*nc;
if wd_byte_no≠relptrbase*2 then error('Something is wrong');
c←bc;
while c≤ec do
  begin
  if glyph_ptr[c]≠-1 then oc_word(glyph_ptr[c]-rel_ptr_base)
		else oc_word(-1); {marking a non-existent char}
  incr(c);
  end;
end;




for c←bc thru ec do
	if charsegptr[c]≠-1 then
		begin
		comment Convert the spacing Xwidth of the character
		  from points into (fixed.fraction) pixels;
		integer newwidth;
		newwidth←(CharWidthX[c]*xresolution*(2↑16))+0.5;
		Dout(doveroc,newwidth);
		newwidth←(CharWidthY[c]*yresolution*(2↑16))+0.5;
		Dout(doveroc,newwidth);
		Wout(doveroc,BBoxArray[c]);
		Wout(doveroc,BBoyArray[c]);
		Wout(doveroc,BBdxArray[c]);
		Wout(doveroc,BBdyArray[c]);
		end
	  else	begin
		integer i;
		for i←1 thru 7 do Wout(doveroc,0);
		Wout(doveroc,-1) # marks a non-existent character;
		end;
relptrbase←charsegfilepos-2*nc;
DEBUGONLY if bytecount[doveroc]≠relptrbase*2 then confusion;
for c←bc thru ec do
	if charsegptr[c]≠-1 then Dout(doveroc,charsegptr[c]-relptrbase)
		else Dout(doveroc,-1); {marking a non-existent char}
end;


design_size←signed_quad; check_sum←signed_quad;@/
print('design size = ',design_size:1,' (');
print_scaled(design_size div 16); print_ln('pt)');

define charwd=⊂realparam[7]⊃ # width of character to be output;
define charht=⊂realparam[8]⊃ # height of character to be output;
define chardp=⊂realparam[9]⊃ # depth of character to be output;

	device_width[c]←signed_quad; {chardw in pixels :integer]
	tfm_width[c]←signed_quad;

@!glyph_ptr: array [0..max_glyph_no] of integer; {called charsegptr in MFDOVR}
@!glyph_cols: array [0..max_glyph_no] of integer; {BBdxArray in MFDOVR}
@!glyph_rows: array [0..max_glyph_no] of integer; {BBdyArray in MFDOVR}
@!min_x_array: array [0..max_glyph_no] of integer; {BBoxArray in MFDOVR}
@!min_y_array: array [0..max_glyph_no] of integer; {BBoyArray in MFDOVR}
@!cols_offset: array [0..max_glyph_no] of integer; 
@!rows_offset: array [0..max_glyph_no] of integer; 







comment special stuff for byte-oriented output;

comment Here are some procedures for doing byte-oriented output. 
	SAIL's normal "wordout" is doing the real work.  The arrays
	nextword holds the bytes that will go into making a new
	output word as they accumulate.  The array bytecount keeps
	track of the total number of bytes output to each file;

*** FROM MFOUT.SAI ***
comment integer array nextword,bytecount[1:numberofmodes];

simp procedure Bout(integer mode, byte);
	begin comment output an 8-bit byte to channel for mode;
	integer cnt,nxtwd,ofst;
	cnt←bytecount[mode];
	case (cnt mod 4) of
	    begin
	    [0] nextword[mode]←byte lsh 28;
	    [1] nextword[mode]←
			  nextword[mode] lor ((byte land '377) lsh 20);
	    [2] nextword[mode]←
			  nextword[mode] lor ((byte land '377) lsh 12);
	    [3] wordout(ochan[mode],
			  nextword[mode] lor ((byte land '377) lsh 4));
	    else confusion
	    end;
	bytecount[mode]←cnt+1;
	end;

simp procedure Wout(integer mode,word);
	begin comment output a 16-bit word to channel for mode;
	integer cnt,nxtwd,ofst;
	cnt←bytecount[mode];
	case (cnt mod 4) of
	    begin
	    [0] nextword[mode]←word lsh 20;
	    [2] wordout(ochan[mode],
			  nextword[mode] lor ((word land '177777) lsh 4));
	    else confusion comment must be at 16-bit-word boundary;
	    end;
	bytecount[mode]←cnt+2;
	end;

simp procedure Dout(integer mode,word);
	begin
	Wout(mode,word lsh -16); Wout(mode, word);
	end;

simp procedure DoutAligned(integer mode,word);
	begin
	integer cnt;
	cnt←bytecount[mode];
	if (cnt mod 4)≠0 then confusion;
	wordout(ochan[mode],word);
	bytecount[mode]←cnt+4;
	end;

simp procedure Sout(integer mode, ptr, numbytes);
	begin comment output a string of 8-bit bytes: the output file
		must start out 32-bit-word aligned!;
	integer i, numwords, rembytes;
	if bytecount[mode] mod 4≠0 then confusion;
	numwords←numbytes div 4;
	rembytes←numbytes mod 4;
	arryout(ochan[mode],memory[ptr],numwords);
	nextword[mode]←memory[ptr+numwords] land (-1 lsh (bitsperwd-8*rembytes));
	bytecount[mode]←bytecount[mode]+numbytes;	
	end;

simp procedure BCPLout(integer mode; string s; integer maxbytes);
	begin
	integer len, i;
	len←(maxbytes-1) min length(s);
	Bout(mode,len);
	for i←1 thru maxbytes-1 do
		if i<=len then Bout(mode,s[i to i]) else Bout(mode,0);
	end;

simp procedure DVISout(integer mode; string s);
	begin
	integer len, i;
	len←length(s);
	Bout(mode,len);
	for i←1 thru len do Bout(mode,s[i to i]);
	end;

IFDOVERMODES
define nonexistentcharflag=⊂-(2.0↑120)⊃ # a real number that won't occur
	as the vector width X component of any real character;
saf real array CharWidthX[0:'177];
saf real array CharWidthY[0:'177] # x and y components of
	the vector widths of characters;
integer bbxlmin, bbxrmax, bbylmin, bbyhmax # extremes of bounding box;
real charwxmax, charwxmin, charwymax, charwymin # extremes of width vector
	components;
define IX(typ, lngth)=⊂((typ lsh 12)+lngth)⊃;
saf integer array charsegptr[0:'177] # filepos's of individual char segments;
define charsegfilepos=⊂('3000)⊃ # earliest filepos in .oc file that a
	character segment can start (in 16-bit words), rounded up to the
	nearest multiple of 2*pagesize(For WAITS' sake!);
ENDDOVERMODES

@An essential part of the work in going from |gf| to |oc| involvs
the shift in scanning direction. This can be done by brute force by generating
a big array of pixels to hold the character image as suggested in \.{GFTYPE}
or it can be done by finesse following the suggestion made by John Hobby.
@↑Hobby, John Douglas@>
Having tried the brute force method and having found it to be quite wasteful
of computer time (and memory space) we have elected to go the other way.

Our task is somewhat easier than that faced in \.{MF.WEB} itself as we
need to contend with but two pixel weights. and our original data has
already been segmented into |paint| commands that mark the vertical edges.
Our task is to locate the horizontal edges between columns by comparing
adjacent pairs of rows and storing the results in linked lists, one list
for each x value in the range from |min_x| to |max_x|. We get these
records in the desired order by inserting each
new edge record between the header of the appropiate list and the immediately
following record. We can then expand each linked list and write
the output data in the prescribed order from bottom up.

@<Constants...@>=
@!max_glyph_no=255; {maximum glyph number in font}
@!max_y_allowed=400; 
@!min_y_allowed=-150;
@!max_x_allowed=400;
@!min_x_allowed=-50;
@!max_p_c=50; {a reasonable figure for the maximum number to vertical edges}

@d p_array==paint_array[y,p_c]

@<Glob...@>=
@!paint_array:array[min_y_allowed..max_y_allowed,0..max_p_c] of integers;
@!p_c: integer; {used as second coordinate in |paint_array|}
@!flag: integer; {used to mark exhaustion of |paint_array| data}


@ @<Clear the paint array@>=
y←min_y_allowed;
while y≤max_y_allowed do
  begin
  p_c←0;
  while p_c≤max_p_c do
    begin
    p_array←0;
    incr(p_c);
    end
  incr(y);
  end;


@ The bulk of a \.{GF} file generally consists of |paint| commands,
so we collect them together and store the extracted information in
the appropiate locations in the |paint_array|.

@<Translate a sequence of |paint| commands...@>=
begin
repeat @<Store it away@>;
start_op;
until o>paint1+3;
end

@ @<Store it away@>=
incr(p_c); p_array←p;
if p>0 then
	begin if y>max_y_observed then max_y_observed←y;
	if y<min_y_observed then min_y_observed←y;
	l←x; r←x+p-1;
	if r>max_x_observed then max_x_observed←r;
	if l<min_x_observed then min_x_observed←l;
	x←r+1;
	end;
paint_switch←white+black-paint_switch
	{could also be |paint_switch←not paint_switch|}

@ @<Translate a |new_row|, |right| or |left| command@>=
begin show_mnemonic('newrow ',p:1);
decr(y); z←z+p; x←z; paint_switch←black;
p_c←0; 
if z>0 then 
  begin
  p_array←white; 
  incr(p_c); p_array←z;
  end else p_array←black;
end;

@ @<Translate a |skip| command@>=
begin
p_c←0;
while p>0 do
  begin
  decr(y);
  p_array←white;
  incr(p_c); p_array←-1; decr(p_c);
  end;
decr(y);
if z>0 then 
  begin
  p_array←white; 
  incr(p_c); p_array←z;
  end else p_array←black;
end
 show_mnemonic('skip',o-skip1+1:1,' ',p:1);
y←y-(p+1); x←z; paint_switch←black;
if wants_mnemonics then print(' (y=',y:1,', z=',z:1,')');
end

@ @<Remove blank rows at left@>=
if min_x_observed>0 then
  begin
  a←min_x_observed;
  y←min_y; p_c←1;
  while y<=max_y do
    begin
    p_array←p_array-a;
    if p_array=0 then
      begin
      paint_array[y,0]←black;
      p_array←paint_array[y,2];
      p_c←2;
      while p_array≠0 do
	begin
	p_array←paint_array[y,p_c+1];
	incr(p_c);
	end;
      p_c←1;
      end;
    incr(y);
    end;
  end;

@ @<Write the |oc| raster@>=
y←min_y; p_c←0;
flag←max_y+1-min_y; {to be reduced by 1 each tine a row is exhausted}
while flag>0 do
  begin
  if y<(max_y-7) then @<Get full byte@>
    else @<Get mixed byte@>;
  oc_byte(b);
  end;
if (oc_byte_no mod 2) ≠0 then oc_byte(0);

@ @<Get full byte@>=
  begin
  b←p_array; incr(y)
  for i←2 to 8 do 
    begin
    b←b*2+p_array; incr(y); incr(i);
    end;
  if y>max_y then  update_array;
  end

@ @<Get mixed byte@>=
  begin
  b←p_array; incr(y);
  while y≤max_y do
    begin
    b←b*2+p_array; incr(y); incr(i);
    end;
  update_array;
  if flag>0 then
    begin
    for i←i to 8 do
      begin
      b←b*2+p_array; incr(y);
      end;
    end
    else
    for i←i to 8 do b←b*2;
  end

@p procedure update_array;
begin
y←min_y; p_c←1;
while y≤max_y do
    begin
    if p_array>0 then 
      begin
      decr(p_array);
      if p_array=0 then @<Effect |paint_switch| change@>;
      end;
    incr(y);
    end;
y←min_y; p_c←0;
end;

@ @<Effect |paint_switch| change@>=
  begin
  if paint_array[y,p_c+1]=0 then 
    begin
    decr(flag); paint_array[y,0]←white;
    end
  else
    begin
    paint_array[y,0]←black+white-paint_array[y,0];
    p_array←paint_array[y,2];
    p_c←2;
    while p_array≠0 do
      begin
      p_array←paint_array[y,p_c+1];
      incr(p_c);
      end;
    p_c←1;
    end;
  end
@ @<Glob...@>=
@!glyph_ptr: array [0..max_glyph_no] of integer;
@!glyph_cols: array [0..max_glyph_no] of integer;
@!glyph_rows: array [0..max_glyph_no] of integer;
@!cols_offset: array [0..max_glyph_no] of integer;
@!rows_offset: array [0..max_glyph_no] of integer;
@!bc,ec:integer;
@!oc_dir_ptr:integer;
@!oc_mag: integer;


If the name of a file ends with th extension .OC, that file by convention,
should contain a single segment of type OrbitChars.


Data segments of type OrbitChars have an internal structure that is a
minature version of the structure of the complete dictionary file. At the
beginning of these segements, there is a table of header information that
specifies the dimensions and widths of each character in the font.next
there is a table of file pointers that give, for each character code, the
location of the corresponding raster block. And finally, there are the
raster blocks themselves.  Most font software always writes the individual
raster blocks in character code order, and without leaving any gaps; that
is the font segment is compact at the character level.

Bask char 97: 3≤x<44   -1≤y<44

43	w	13	11
42	w	10	17
41	w	8	7	7	7
40	w	7	11	7
39	w	6	6	13	7	
38	w	6	5	14	8
37	w	5	6	15	8	
36	w	5	6	15	8
35	w	5	6	15	8
34	w	5	6	15	9
33	w	5	6	15	9
32	w	6	4	16	9
31	w	26	9
30	w	26	9
29	w	26	9
28	w	26	9
27	w	26	9
26	w	26	9
25	w	24	11
24	w	22	13
23	w	19	6	1	9
22	w	17	5	4	9
21	w	15	5	6	9
20	w	13	6	7	9
19	w	11	6	10	8
18	w	10	6	11	8
17	w	8	7	12	8
16	w	7	7	13	8
15	w	6	7	14	8
14	w	5	8	14	8
13	w	5	8	14	8
12	w	4	8	15	8
11	w	4	8	15	8
10	w	3	9	15	8
9	w	3	9	15	8
8	w	3	9	15	8
7	w	3	9	14	9
6	w	3	10	12	10	7	2
5	w	4	9	10	12	7	1
4	w	4	11	6	5	2	8	5	2
3	w	5	19	4	15
2	w	6	17	6	13
1	w	7	14	9	11
0	w	9	10	13	7
-1	w	11	 6